perm filename FOO[C,JRA]1 blob
sn#014376 filedate 1972-11-29 generic text, type T, neo UTF8
00050 (SETQ IBASE 10.)
00100 (DE PICKIT(L N)
00200 (PROG(M I J L1)
00300 (SETQ J (ADD1(LENGTH L)))
00500 L1(SETQ I 1)
00600 (SETQ L1 L)
00700 L(COND((NULL L1)(RETURN N))
00750 ((OR(EQ(CAR L1) N)
00775 (EQ(PLUS(CAR L1) I)(PLUS N J))
00800 (EQ(DIFFERENCE(CAR L1) I)(DIFFERENCE N J)))(GO AGAIN)))
00900 (SETQ L1(CDR L1))
01000 (SETQ I(ADD1 I))
01050 (GO L)
01100 AGAIN(SETQ N(ADD1 N))
01200 (COND((GREATERP N 8)(RETURN NIL)))
01300 (GO L1)
01400 ))
01500 (DE QUEEN()
01600 (PROG(ANS N M CONTEXT)
01650 (SETQ N 1)
01700 L (COND((EQ(LENGTH ANS) 8)(RETURN ANS)))
01750 LL(PRINT(LIST ANS N))
01800 (SETQ M(PICKIT ANS N))
01900 (COND(M
02000 (SETQ CONTEXT(CONS(CONS M ANS)CONTEXT))
02050 (SETQ ANS(APPEND ANS(LIST M)))
02100 (SETQ N 1)(GO L)))
02200 LLL(SETQ N(CAAR CONTEXT))(SETQ ANS(CDAR CONTEXT))(SETQ CONTEXT(CDR CONTEXT))
02325 (SETQ N(ADD1 N))
02350 (COND((GREATERP N 8)(GO LLL)))(GO LL)
02400 ))
02500 (QUEEN)